home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATH1 / SORT-Q-N.LIB < prev    next >
Text File  |  1985-04-03  |  1KB  |  74 lines
  1.  
  2.  
  3. { --> 183}
  4. procedure sort(var x: ary; n: integer);
  5. { a NONRECURSIVE quicksort routine }
  6. { Adapted from 'Software-Tools',
  7.     B.Kernighan, Addison Wesley, 1976 }
  8.  
  9. var    left,right    : array[1..20] of integer;
  10.     i,j,sp,mid    : integer;
  11.     pivot        : real;
  12.  
  13. procedure swap(var p,q: real);
  14. var    hold    : real;
  15.  
  16. begin
  17.   hold:=p;
  18.   p:=q;
  19.   q:=hold
  20. end;        { swap }
  21.  
  22.  
  23. begin
  24.   left[1]:=1;
  25.   right[1]:=n;
  26.   sp:=1;
  27.   while sp>0 do
  28.     begin
  29.       if left[sp]>=right[sp] then sp:=sp-1
  30.       else
  31.     begin
  32.       i:=left[sp];
  33.       j:=right[sp];
  34.       pivot:=x[j];
  35.       mid:=(i+j)div 2;
  36.       if (j-i)>5 then
  37.         if ((x[mid]<pivot)and(x[mid]>x[i]))
  38.           or
  39.         ((x[mid]>pivot)and(x[mid]<x[i]))
  40.           then swap(x[mid],x[j])
  41.         else
  42.           if((x[i]<x[mid])and(x[i]>pivot))
  43.         or ((x[i]>x[mid])and(x[i]<pivot))
  44.           then swap(x[i],x[j]);
  45.     pivot:=x[j];
  46.     while i<j do
  47.       begin
  48.     while x[i]<pivot do
  49.       i:=i+1;
  50.     j:=j-1;
  51.     while (i<j)and(pivot<x[j]) do
  52.       j:=j-1;
  53.     if i<j then swap(x[i],x[j])
  54.     end;    { while }
  55.     j:=right[sp];    { pivot to i }
  56.     swap(x[i],x[j]);
  57.     if i-left[sp]>=right[sp]-i then
  58.       begin        { put shorter part first }
  59.     left[sp]+1:=left[sp];
  60.     right[sp+1]:=i-1;
  61.     left[sp]:=i+1
  62.       end
  63.     else
  64.       begin
  65.     left[sp+1]:=i+1;
  66.     right[sp+1]:=right[sp];
  67.     right[sp]:=i-1
  68.       end;
  69.     sp:=sp+1        { push stack }
  70.   end        { if }
  71.  end        { while }
  72. end;    { QUICK SORT }
  73.  
  74.